import System.IO
import Data.List
import Data.Ord
import Data.Tuple
import Data.List.Split

-- Type definitions and class instantiations

data Suit = Clubs | Diamonds | Hearts | Spades deriving (Show,Eq,Ord)

data Rank = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Show,Eq,Ord)

data Card = Card Rank Suit deriving (Eq)

instance Show Card where 
	show (Card r s) = show r ++ " of " ++ show s
	
instance Ord Card where
	compare (Card r1 s1) (Card r2 s2)
		|rc == GT = GT
		|rc == LT = LT
		|rc == EQ = compare s1 s2
		where
			rc = compare r1 r2

data Hand = Hand {c1 :: Card, c2 :: Card, c3 :: Card, c4 :: Card, c5 :: Card} deriving (Show, Eq)

instance Ord Hand where
	compare h1 h2 = 
		case compare rh1 rh2 of
			LT -> LT
			GT -> GT
			EQ -> comparing (fst.last.(sortBy (comparing snd)).groupHandByRank) h1 h2
			where 
				rh1 = rankHand h1
				rh2 = rankHand h2
		

data Game = Game Hand Hand

instance Show Game where
	show (Game p1 p2) = 
		"Player 1 \t\tPlayer 2 \n" ++
		"======== \t\t========\n" ++ 
		show (c1 p1) ++ "\t" ++ show (c1 p2) ++ "\n" ++
		show (c2 p1) ++ "\t" ++ show (c2 p2) ++ "\n" ++
		show (c3 p1) ++ "\t" ++ show (c3 p2) ++ "\n" ++ 
		show (c4 p1) ++ "\t" ++ show (c4 p2) ++ "\n" ++
		show (c5 p1) ++ "\t" ++ show (c5 p2) ++ "\n"

data HandRank = 
	  HighCard Card
	| Pair Rank
	| TwoPair (Rank, Rank)
	| ThreeOfAKind Rank
	| Straight Rank
	| Flush Suit
	| FullHouse (Rank, Rank)
	| FourOfAKind Rank
	| StraightFlush
	| RoyalFlush
	deriving (Show, Eq, Ord)
	
data GameResult = Player1 | Player2 | Draw deriving (Show, Eq)
	
-- Hand functions
-----------------
handFromList :: [Card] -> Hand
handFromList [a,b,c,d,e] = Hand { c1=a,c2=b,c3=c,c4=d,c5=e }

toList :: Hand -> [Card]
toList (Hand { c1=a,c2=b,c3=c,c4=d,c5=e }) = [a,b,c,d,e]

handFromListOfLists :: [String] -> Hand
handFromListOfLists [a,b,c,d,e] = Hand { c1=cardFromList a,c2=cardFromList b,c3=cardFromList c,c4=cardFromList d,c5=cardFromList e }
	
rankHand :: Hand -> HandRank
rankHand a 
	| isStraightFlush a = if (getRank.highestCard) a == Ace 
							then RoyalFlush
							else StraightFlush
	| n == 4			= FourOfAKind (getNOfAKindRank a)
	| isFullHouse a		= FullHouse ( getRank $ lowestCard a, getRank $ highestCard a )
	| isStraight a 		= Straight( getRank $ highestCard a )
	| isFlush a 		= Flush ( getSuit $ highestCard a )
	| n == 3			= ThreeOfAKind (getNOfAKindRank a)
	| isTwoPair a		= TwoPair (getTwoPairRanks a)
	| n == 2			= Pair (getNOfAKindRank a)
	| otherwise 		= HighCard ( highestCard a)
	where n = isNOfAKind a

isStraight :: Hand -> Bool
isStraight c = isStraightList $ reverse $ sort $ toList c
	where
		isStraightList (x:xs) = if xs == []
		then True
		else case zr of
			Nothing -> False
			Just z -> (getRank z == getRank(head xs)) && isStraightList xs
			where zr = previousCard x

isFlush :: Hand -> Bool
isFlush = ((==1).length.(nubBy sameSuit).toList)

isStraightFlush :: Hand -> Bool
isStraightFlush x = (isFlush x) && (isStraight x)

sortHand :: Hand -> Hand
sortHand = handFromList.reverse.sort.toList

highestCard :: Hand -> Card
highestCard hand = maximum $ toList hand

lowestCard :: Hand -> Card
lowestCard hand = minimum $ toList hand

isNOfAKind :: Hand -> Int
isNOfAKind a = snd $ maximumBy (comparing snd) $ groupHandByRank a

getNOfAKindRank :: Hand -> Rank
getNOfAKindRank a = fst $ maximumBy (comparing snd) $ groupHandByRank a


isFullHouse :: Hand -> Bool
isFullHouse hand
	| length xs /= 2 	= False
	| ((snd.head) xs == 2) && ((snd.last) xs == 3) = True
	| otherwise = False
	where 
		xs = sortBy (comparing snd) $ groupHandByRank hand

isTwoPair :: Hand -> Bool
isTwoPair hand
	| length xs /= 3 = False
	| otherwise = snd (xs !! 2) == 2 && snd (xs !! 1) == 2 
	where
		xs = sortBy (comparing snd) $ groupHandByRank hand

getTwoPairRanks :: Hand -> (Rank, Rank)
getTwoPairRanks hand = (fst (xs !! 2), fst (xs !! 1))
	where
		xs = sortBy (comparing snd) $ groupHandByRank hand
		
groupHandByRank :: Hand -> [(Rank,Int)]
groupHandByRank a = map (\x->(getRank(head x),length x)) $ groupBy sameRank $ sortBy (comparing getRank) $ toList a


-- Rank Functions
-----------------

rankFromChar :: Char -> Rank
rankFromChar a 
		| a == '1' = Ace
		| a == '2' = Two
		| a == '3' = Three
		| a == '4' = Four 
		| a == '5' = Five 
		| a == '6' = Six
		| a == '7' = Seven
		| a == '8' = Eight
		| a == '9' = Nine 
		| a == 'T' = Ten
		| a == 'J' = Jack 
		| a == 'K' = King 
		| a == 'Q' = Queen
		| a == 'A' = Ace

-- Suit functions
-----------------
		
suitFromChar :: Char -> Suit
suitFromChar a
		| a == 'C' = Clubs
		| a == 'D' = Diamonds
		| a == 'H' = Hearts
		| a == 'S' = Spades

-- Card functions
-----------------
		
cardFromList :: String -> Card
cardFromList (x:xs) = Card (rankFromChar x) (suitFromChar(head xs))

getRank :: Card -> Rank
getRank (Card r _) = r

getSuit :: Card -> Suit
getSuit (Card _ s) = s

sameSuit :: Card -> Card -> Bool
sameSuit (Card _ s1) (Card _ s2) = s1 == s2

sameRank :: Card -> Card -> Bool
sameRank (Card r1 _) (Card r2 _) = r1 == r2

nextCard :: Card -> Maybe Card
nextCard (Card r s) 
	|r == Two		= Just (Card Three s  )
	|r == Three 	= Just (Card Four s   )
	|r == Four		= Just (Card Five s   )
	|r == Five		= Just (Card Six s    )
	|r == Six		= Just (Card Seven s  )
	|r == Seven  	= Just (Card Eight s  )
	|r == Eight  	= Just (Card Nine s   )
	|r == Nine		= Just (Card Ten s    )
	|r == Ten		= Just (Card Jack s   )
	|r == Jack		= Just (Card Queen s  )
	|r == Queen  	= Just (Card King s   )
	|r == King		= Just (Card Ace s	  )
	|r == Ace		= Nothing

previousCard :: Card -> Maybe Card
previousCard (Card r s) 
	|r == Two		= Nothing
	|r == Three 	= Just (Card Two s    )
	|r == Four		= Just (Card Three s  )
	|r == Five		= Just (Card Four s   )
	|r == Six		= Just (Card Five s   )
	|r == Seven  	= Just (Card Six s    )
	|r == Eight  	= Just (Card Seven s  )
	|r == Nine		= Just (Card Eight s  )
	|r == Ten		= Just (Card Nine s   )
	|r == Jack		= Just (Card Ten s    )
	|r == Queen  	= Just (Card Jack s   )
	|r == King		= Just (Card Queen  s )
	|r == Ace		= Just (Card King   s )
	
	
-- Game Functions
-----------------

game :: Hand -> Hand -> Game
game h1 h2 = Game h1 h2

gameFromTwoLists :: [String] -> [String] -> Game
gameFromTwoLists xs ys = Game ((sortHand.handFromListOfLists) xs) ((sortHand.handFromListOfLists) ys)

gameResult :: Game -> GameResult
gameResult (Game h1 h2) = case (compare h1 h2) of
	GT -> Player1
	LT -> Player2
	EQ -> Draw

main = do
	list <- readFile "poker.txt"
	let [player1List, player2List] = transpose $ (map (chunksOf 5).map (splitOn " ").lines) list
	let gameList = zipWith gameFromTwoLists player1List player2List
	let resultList = map (\x->(x,gameResult x)) gameList
	(putStrLn.show) $ length(filter ((== Player1).snd) resultList)